Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mquery/mfilter.frm

Text File | 1995-05-02 | 8KB | 292 lines

VERSION 2.00
Begin Form fFilter
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Filter"
   ClientHeight    =   2370
   ClientLeft      =   3390
   ClientTop       =   3675
   ClientWidth     =   5070
   ControlBox      =   0   'False
   Height          =   2775
   Left            =   3330
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2412
   ScaleMode       =   0  'User
   ScaleWidth      =   5160
   Top             =   3330
   Width           =   5190
   Begin ListBox cFieldList
      BackColor       =   &H00FFFFFF&
      Height          =   1395
      Left            =   240
      TabIndex        =   2
      Tag             =   " OL"
      Top             =   360
      Width           =   1695
   End
   Begin ListBox cOpsList
      BackColor       =   &H00FFFFFF&
      Height          =   1395
      Left            =   2040
      TabIndex        =   7
      Tag             =   " OL"
      Top             =   360
      Width           =   960
   End
   Begin TextBox cExpr
      BackColor       =   &H00FFFFFF&
      Height          =   287
      Left            =   3120
      TabIndex        =   1
      Tag             =   " OL"
      Top             =   360
      Width           =   1811
   End
   Begin CommandButton OkayButton
      Caption         =   "&OK"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   372
      Left            =   600
      TabIndex        =   4
      Top             =   1919
      Width           =   1691
   End
   Begin CommandButton CancelButton
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   372
      Left            =   2879
      TabIndex        =   5
      Top             =   1919
      Width           =   1691
   End
   Begin Label Label1
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Do not use quotes"
      Height          =   195
      Left            =   3195
      TabIndex        =   8
      Top             =   720
      Width           =   1605
   End
   Begin Label OpsLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Operators:"
      Height          =   192
      Left            =   2039
      TabIndex        =   6
      Top             =   120
      Width           =   971
   End
   Begin Label FieldListLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Fields:"
      Height          =   192
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   1092
   End
   Begin Label ExprLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Value or Expression:"
      Height          =   192
      Left            =   3120
      TabIndex        =   0
      Top             =   120
      Width           =   1811
   End
End
Option Explicit
Dim FNotFound As Integer

Sub CancelButton_Click ()
  Hide
  'set the flag for the dynaset/dynagrid form
  gfFindFailed = True
End Sub

Sub cExpr_Change ()
  If cFieldList <> "" And cOpsList <> "" And cExpr <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub cExpr_KeyPress (keyascii As Integer)
If keyascii = 34 Then
keyascii = 0
End If



End Sub

Sub cFieldList_Click ()
  If cFieldList <> "" And cOpsList <> "" And cExpr <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub cOpsList_Click ()
  If cFieldList <> "" And cOpsList <> "" And cExpr <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub Form_Load ()

   Me.Left = (screen.Width - Me.Width) / 2
   Me.Top = (screen.Height - Me.Height) / 2

  FNotFound = False
  cOpsList.AddItem "="
  cOpsList.AddItem "<>"
  cOpsList.AddItem ">="
  cOpsList.AddItem "<="
  cOpsList.AddItem ">"
  cOpsList.AddItem "<"
  cOpsList.AddItem "Like"
End Sub

Sub Form_Paint ()
  Outlines Me
End Sub

Sub OkayButton_Click ()
   Dim i As Integer
   Dim isit As Variant ' checking for dates and numbers
   Dim j As Integer
   Dim k As Integer
   Dim TableStr() As String ' stores multiple table names
   Dim l As Integer
   Dim addFltr As String ' adds proper table name to filter

   On Error GoTo FindErr


   FNotFound = False
   SetHourGlass Me

   gstFindField = cFieldList
   gstFindExpr = cExpr
   gstFindOp = cOpsList

  ' add table name to field for proper sql statement
  ' get tables, may be a few

  Do
  i = InStr(1, gTblname, ",")
    If i = Len(gTblname) Then  ' last can end with a comma
        gTblname = Left(gTblname, i - 1)
        Exit Do
    End If

       If i > 0 Then  ' if a comma then 1 to comma-1 is first table
           ' take first table
           ReDim Preserve TableStr(j)
           TableStr(j) = Left(gTblname, i - 1) & "."
           ' strip TableStr(j) from gTblName
           gTblname = Mid(gTblname, i + 1, Len(gTblname))
           j = j + 1 ' increment counter
       End If
  Loop Until i = 0
  ' get last table if more than one cause above code doesn't
  If j > 0 Then
    ReDim Preserve TableStr(j)
    TableStr(j) = gTblname & "."
    gTblname = ""
  End If
    Select Case gTblname
        Case Is = ""' multiple tables
        For l = 0 To j
        For i = 1 To Len(gstDynaString)
           If k > 1 Then Exit For
            k = InStr(i, UCase(gstDynaString), UCase(TableStr(l) & "[" & gstFindField & "]"))
             If k > 1 Then
                 addFltr = TableStr(l)
                 Exit For
                 End If
       Next i
       Next l
    Case Else  'single table
       addFltr = Trim(gTblname & ".")
    End Select


   isit = cExpr

   'see if it's a date field
        If IsDate(isit) Then
        i = InStr(1, gstFindField, " ")
           If i > 0 Then
            gFilterStr = "[" + gstFindField + "]" + " " + gstFindOp + " " + "#" + gstFindExpr + "#"
           Else
            gFilterStr = gstFindField + " " + gstFindOp + " " + "#" + gstFindExpr + "#"
           End If
        Hide
        GoTo Findend
        'Stop'
        End If


   If IsNumeric(isit) Then
   ' pass it, it's a number but put quotes around field name
        i = InStr(1, gstFindField, " ")
           If i > 0 Then
            gFilterStr = "[" + gstFindField + "]" + " " + gstFindOp + " " + gstFindExpr
           Else
            gFilterStr = gstFindField + " " + gstFindOp + " " + gstFindExpr
           End If
   Else
   ' put brackets around expression
       ' i = InStr(1, gstFindField, " ")
           'If i > 0 Then
            gFilterStr = "[" + gstFindField + "]" + " " + gstFindOp + " " + Chr(34) + gstFindExpr + Chr(34)
           'Else
            'gFilterStr = gstFindField + " " + gstFindOp + " " + Chr(34) + gstFindExpr + Chr(34)
           'End If
  End If
   gFilterStr = addFltr + gFilterStr

' see if this was not a stored query..if not add to SQL statement for save
 If Not gStoredFlag Then
    i = InStr(1, UCase(gstDynaString), "WHERE") 'see if a where exists
        If i = 0 Then
            gstDynaString = Trim(gstDynaString & " Where " & "(" & gFilterStr & ")")
        Else
            k = InStr(i + 5, gstDynaString, ")")
            addFltr = Mid(gstDynaString, k + 1, Len(gstDynaString)) ' more at end?
            gstDynaString = Trim(Mid(gstDynaString, 1, k - 1) & " And " & gFilterStr & ")" & " " & addFltr)
        End If
 End If

   Hide
   GoTo Findend

FindErr:
   If Err <> EOF_ERR Then
     ShowError
     Resume Findend
   Else
     FNotFound = True
     Resume Next
   End If

Findend:
   ResetMouse Me

End Sub